home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Source Code / Peter Lewis / Finger 1.3.5 / source / Finger / Main.p < prev    next >
Encoding:
Text File  |  1992-02-24  |  4.6 KB  |  219 lines  |  [TEXT/PJMM]

  1. program Main;
  2.  
  3. { This code is part of the Finger/Fingerd source code, written in THINK Pascal 4 }
  4. { Copyright 1991-1992 Peter N Lewis }
  5. { If you use this code, you must give me credit in your about box and documentation }
  6.  
  7.     uses
  8.         OOMainLoop, OOMenus, MyNotifier, MyAppleEvents, TCPConnections, MyHandleQuitBoth,{}
  9.         FingerDaemon, MyInternetMenu, Fingers, MyGrowZones, Preferences, MyPrinting, MyTEPrinting;
  10.  
  11.     var
  12.         launched_with_option: boolean;
  13.  
  14.     function DoOApp: OSErr;
  15.     begin
  16.         DoOApp := noErr;
  17.     end;
  18.  
  19.     function DoODoc (fs: FSSpec): OSErr;
  20.         var
  21.             pb: CInfoPBRec;
  22.             oe: OSErr;
  23.     begin
  24.         GetPreferences(fs.vRefNum, fs.parID, fs.name);
  25.         DoODoc := noErr;
  26.     end;
  27.  
  28.     function DoQuit: OSErr;
  29.     begin
  30.         DoCommand(0, 0, Cquit);
  31.         DoQuit := noErr;
  32.     end;
  33.  
  34.     procedure UnloadAll;
  35.     begin
  36.         UnloadSeg(@SegmentInit);
  37.         UnloadSeg(@SegmentUtil);
  38.         UnloadSeg(@SegmentUtil2);
  39.         UnloadSeg(@SegmentSystem7);
  40.         UnloadSeg(@SegmentTerm);
  41.         UnloadSeg(@SegmentMFS);
  42.         UnloadSeg(@SegmentMFSByte);
  43.         UnloadSeg(@SegmentPrefs);
  44.         UnloadSeg(@SegmentPrinting);
  45.     end;
  46.  
  47.     procedure SetFingerMenu (themenu, theitem: integer);
  48.         var
  49.             t, c: longInt;
  50.     begin
  51.         PurgeSpace(t, c);
  52.         SetIDItemEnable(themenu, theitem, (t > 12000) and (c > 6000));
  53.     end;
  54.  
  55.     procedure SetPrintMenu (themenu, theitem: integer);
  56.     begin
  57.         SetIDItemEnable(themenu, theitem, IsFingerWindow(FrontWindow));
  58.     end;
  59.  
  60.     procedure SetGoodPort;
  61.         var
  62.             wmgrportP: ^grafptr;
  63.     begin
  64.         if FrontWindow <> nil then
  65.             SetPort(FrontWindow)
  66.         else begin
  67.             wmgrportP := POINTER($9DE);
  68.             Setport(wmgrportP^);
  69.         end;
  70.     end;
  71.  
  72.     function HandleMainEvents (var er: eventRecord): boolean;
  73.         var
  74.             b: boolean;
  75.             fw: windowPtr;
  76.     begin
  77.         SetGoodPort;
  78.         if SetOOMenuBar then
  79.             DrawMenuBar;
  80.         if in_foreground then
  81.             NotifyCompletion;
  82.         fw := FrontWindow;
  83.         b := GetWObject(fw).WaitForEvent(er, 10);
  84.         b := GetWObject(fw).HandleEvents(er);
  85.         SetGoodPort;
  86.         HandleMainEvents := b;
  87.     end;
  88.  
  89.     procedure MyDoFMenu (themenu, theitem: integer);
  90.         var
  91.             s: str255;
  92.     begin
  93.         giveOoMerror := true;
  94.         case themenu of
  95.             M_InternetTo:  begin
  96.                 DoFingerCommand(GetInternetCommand(themenu, theitem));
  97.                 HiliteMenu(0);
  98.             end;
  99.             M_RemoveTo:  begin
  100.                 RemoveInternetCommand(themenu, theitem);
  101.                 HiliteMenu(0);
  102.             end;
  103.             otherwise
  104.                 DoFMenu(themenu, theitem);
  105.         end;
  106.     end;
  107.  
  108.     var
  109.         pob: TEPObject;
  110.  
  111.     procedure MyPrint;
  112.     begin
  113.         UnloadAll;
  114.         pob.te := GetFingerTE(FrontWindow);
  115.         PrintStuff(pob, thePrintingRecordHandle);
  116.     end;
  117.  
  118.     procedure MyPageSetup;
  119.     begin
  120.         DoPageSetup(pob, thePrintingRecordHandle);
  121.     end;
  122.  
  123.     function StackPtr: longInt;
  124.     inline
  125.         $2E8F;
  126.  
  127.     const
  128.         gestaltMacTCPAttr = 'mtcp';
  129.  
  130.     var
  131.         er: eventRecord;
  132.         paramCount, paramMessage: integer;
  133.         af: appFile;
  134.         oe: OSErr;
  135.         dummyb: boolean;
  136.         mainloop_dobj: DefObject;
  137.         a, i: integer;
  138.         appllimitP: ^longInt;
  139.         gv: longInt;
  140. begin
  141.     applLimitP := POINTER($130);
  142.     applLimitP^ := StackPtr - 12000;
  143. {    SetApplLimit(ptr(StackPtr - 5000));}
  144.     MaxApplZone;
  145.     InitGrowZone(outofmem_alert_id);
  146.     if MemoryCritical then begin
  147.         a := Alert(outofmem_alert_id, nil);
  148.         halt;
  149.     end;
  150.     giveOoMerror := true;
  151.     dummyb := GetOSEvent(0, er);
  152.     launched_with_option := BAND(er.modifiers, optionKey) <> 0;
  153.     InitNotify;
  154.     InitUtilities;
  155.     if not has_AppleEvents then begin
  156.         CountAppFiles(paramMessage, paramCount);
  157.         if paramMessage <> appOpen then { Must be Open, not Print! }
  158.             begin
  159.             FailAlert('Sorry, I can''t print ', 0);
  160.             halt;
  161.         end;
  162.         for i := 1 to paramCount do begin
  163.             GetAppFiles(i, af);
  164.             with af do
  165.                 if fType = myAppType then begin
  166.                     GetPreferences(vRefNum, 0, fName);
  167.                     ClrAppFiles(i);
  168.                 end;
  169.         end;
  170.     end
  171.     else
  172.         oe := InitAppleEvents(@DoOApp, @DoODoc, nil, @DoQuit);
  173.     oe := InitConnections('Hosts');
  174.     if oe <> noErr then begin
  175.         FailAlert('TCP Initialize failed with ', oe);
  176.         halt;
  177.     end;
  178.     new(mainloop_dobj);
  179.     InitMainLoop(DObject(mainloop_dobj), @MyDoFMenu);
  180.     InitOOMenus(nil, GetGlobalString(help_menu_text));
  181.     InitPrinting;
  182.     new(pob);
  183.     pob.Create;
  184.     InitPreferences;
  185.     InitQuitBoth('PLFD');
  186.     SetFBoth(Cfinger, @Finger, @SetFingerMenu);
  187.     SetFSetMenu(CXInternet, @SetXMenu);
  188.     SetFSetMenu(CXRemove, @SetXMenu);
  189.     SetFCommand(CPageSetup, @MyPageSetup);
  190.     SetFBoth(Cprint, @MyPrint, @SetPrintMenu);
  191.     InitCursor;
  192.     oe := Gestalt(gestaltMacTCPAttr, gv);
  193.     has_MacTCP11 := (oe = noErr) and (gv >= 1);
  194.     InitInternetMenu;
  195.     InitFingers;
  196.  
  197.     if prefs.autoopen then
  198.         Finger;
  199.     while not quitNow do begin
  200.         UnloadAll;
  201.         GrowZoneIdle;
  202.         IdleFingers;
  203.         dummyb := HandleMainEvents(er);
  204.         HandleFingerTCPEvents;
  205.         if quitNow then
  206.             quitNow := not FinishPreferences;
  207.     end;
  208.  
  209.     pob.Destroy;
  210.     FinishPrinting;
  211.     FinishFingers;
  212.     FinishInternetMenu;
  213.     FinishQuitBoth;
  214.     FinishOOmenus;
  215.     FinishMainLoop;
  216.     FinishEverything;  { buggers up the resources for some god forsaken reason }
  217.     FinishNotify;
  218.     FinishGrowZone;
  219. end.